home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / Toolbox classes / TEview < prev    next >
Text File  |  1996-11-05  |  4KB  |  218 lines
  1. \ Aug 96    mrh    Initial version
  2. \ Sep 96    mrh    added selectAll:, selectLine:
  3.  
  4. need window+
  5. need TextEdit
  6.  
  7.  
  8. \ TEView is a simple non-scrolling TextEdit view.  It has some code
  9. \  lifted from TEScroller, but is a lot simpler.
  10.  
  11.  
  12. objptr  $TMP  class_is string+
  13.  
  14. :class  TEView  super{ view }
  15.  
  16.     TextEdit    theTE 
  17.     byte        mouse_was_here?
  18.  
  19.  
  20. :m >font:  ( font# -- )  >font: theTE  ;m
  21.  
  22. :m >fontSize:  ( n -- )  >fontSize: theTE  ;m
  23.  
  24. :m >color:  ( red green blue -- )  >color: theTE  ;m
  25.  
  26. :m >style:  ( n -- )        >style: theTE  ;m
  27.  
  28.  
  29. :m SIZE:    \ ( -- n )
  30.     size: theTE  ;m
  31.  
  32.  
  33. :m ENABLE:
  34.     enable: super 
  35.     activate: theTE ;m      
  36.  
  37. :m DISABLE:
  38.     disable: super
  39.     deactivate: theTE ;m    
  40.  
  41.  
  42. :m MOVED:  { \ x y dx dy adr -- }
  43.  
  44.     getViewRect: self  2drop  -> y  -> x
  45.  
  46.     moved: super
  47.     get: alive?  0EXIT
  48.     getViewRect: self  setViewRect: theTE
  49.     getViewRect: self  2drop  y -  -> dy  x -  -> dx
  50.  
  51. \ now we must do some of the work in FixPanRect: of TEScroller.  We
  52. \  assume we're not wrapping.
  53.  
  54.     handle: theTE @  -> adr
  55.  
  56.     32766 getpoint: theTE -> y  -> x
  57.     y  adr 4+  w!            \ Adjust bottom of dest rect and
  58.     800  adr 6 + w!            \ right coordinate if not wrapping **** change as necessary
  59.                             \ - 1600 for Mops, 500 for Scriptor.  Make it an ivar soon!!
  60.     size: theTE
  61.     getpoint: theTE nip adr 4 + w!  \ Adjust bottom of dest rect
  62.  
  63.     dx dy or  IF  dx dy  scroll: theTE  THEN
  64.  
  65.     ^viewRect: self  clear: class_as> rect
  66. ;m
  67.  
  68.  
  69. :m (DRAW):
  70.     \ TE looks after clipping itself, so we don't need our default clipping.
  71.     \ It would cause problems anyway, since we use the grafport origin when
  72.     \ calling TE, while our default clipping uses view origin.  So we
  73.     \ disable our own clipping.
  74.  
  75.     false  put: setClip?
  76.     noClip            \ Experimentation shows this is definitely necessary!!
  77.     setTempRect: self
  78.     addr: tempRect  call eraserect
  79.     addr: viewRect  update: theTE
  80. ;m        
  81.  
  82. :m DRAW:    (draw): self  ;m
  83.  
  84.         
  85. :m SETSELECT:  { strt end -- }
  86.     pushPort  set: [ get: ^myWind ]
  87.     strt end  select: theTE 
  88. \    update: [ get: ^myWind ]
  89.     popPort  ;m
  90.  
  91.  
  92. :m SELECTALL:
  93.     pushPort  set: [ get: ^myWind ]
  94.     selectAll: theTE 
  95.     popPort  ;m
  96.  
  97. :m SELECTLINE:
  98.     getLine: theTE  2drop    \ need sideffect of setting lineStart and lineEnd
  99.     lineStart lineEnd  setSelect: self
  100. ;m
  101.  
  102.  
  103. :m CARETLOC:    \ ( -- x y )
  104.     selstart: theTE
  105.     getpoint: theTE  ;m
  106.     
  107.  
  108. :m CLICK:
  109.     click: super
  110.     click: theTE
  111. ;m
  112.  
  113. :m KEY:  { char -- }
  114.     noClip                        \ it seems we can sometimes be clipped out
  115.     char  key: theTE
  116. ;m
  117.  
  118. :m INSERT:  \ ( addr len )
  119.     noClip                        \ it seems we can sometimes be clipped out
  120.     insert: theTE
  121. ;m        
  122.  
  123. :m $INSERT: ( str -- ) { \ adr -- }
  124.     ['] $tmp !        \ may be a subclass of string+
  125.     get: $tmp  insert: self  ;m
  126.  
  127. :m +:  ( c -- )
  128.     pad c!
  129.     pad 1  insert: self  ;m
  130.  
  131.  
  132.  
  133. :m NEW:
  134.     new: super
  135.     addr: viewRect  dup  new: theTE
  136. ;m
  137.  
  138.  
  139. :m CUT:            cut: theTE  ;m    
  140.  
  141. :m COPY:        copy: theTE  ;m    
  142.  
  143. :m PASTE:        paste: theTE  ;m    
  144.  
  145. :m CLEAR:        clear: theTE  ;m
  146.  
  147. :m CLEARALL:    noclip  selectAll: self  clear: theTE  ;m
  148.  
  149. :m TextHandle:    textHandle: theTE  ;m
  150.  
  151.  
  152. :m GETSELECT:   \ ( -- addr len )       \ return hilited selection  
  153.         getselect: theTE ;m
  154.  
  155. \ getline: will return the entire line in which the cursor is currently in,
  156. \ regardless of where in the line the cursor is located.  No text need be
  157. \ selected.
  158.  
  159. :m GETLINE:     \ ( -- addr len )  
  160.         getline: theTE ;m
  161.  
  162. :m RELEASE:  
  163.         release: theTE ;m
  164.  
  165. :m HANDLE:      \ ( -- TEhndl )  
  166.         handle: theTE ;m
  167.  
  168. :m getText:        \ ( -- addr len )
  169.         get: theTE  ;m
  170.  
  171. :m SELEND:      \ ( -- n )  
  172.         selend: theTE ;m
  173.         
  174. :m SELSTART:    \ ( -- n )  
  175.         selstart: theTE ;m
  176.  
  177. :m LINEEND:    \ ( -- n )    \ ** 
  178.     lineEnd: theTE ;m
  179.  
  180. private
  181. :m check_mouse?:  { \ mouseHere? -- mouseHere? changed? }
  182.     mouseHere?: self  -> mouseHere?
  183.     mouseHere?
  184.     get: mouse_was_here?  mouseHere? <>
  185.     mouseHere? put: mouse_was_here?
  186. ;m
  187.  
  188. public
  189.     
  190. :m IDLE:
  191.     idle: super
  192.     nil?: ^myWind ?EXIT
  193.     self
  194.     get: ^myWind  get: ivar> ^view_in_focus in class_as> window
  195.     =  0EXIT            \ do nothing else if we're not in focus
  196.  
  197. \ now we set the cursor if we have to - we only do this if the mouse
  198. \  has just moved into or out of our area.  Otherwise we do nothing.
  199. \  This avoids pointer flickering problems.
  200.  
  201.     check_mouse?: self
  202.     IF        \ changed
  203.         ( in our area? )  IF ibeamcurs  ELSE  arrowCurs  THEN
  204.     ELSE    drop
  205.     THEN
  206.  
  207.     idle: theTE  ;m
  208.  
  209.  
  210. :m CLASSINIT:
  211.     classinit: super
  212.     set: canHaveFocus?
  213.     1 put: mouse_was_here?  ;m
  214.  
  215. :m dump:    dump: super  dump: theTE ;m
  216.  
  217. ;class
  218.